with Ada.Calendar; use Ada.Calendar;
with Legend.Stages;
with Legend.StrRes;
with Legend.Traces;
with Legend.Stages.Rooms, Legend.Stages.WarFields;
with Legend.Timers;
with Legend.Generic_Search_Path;
package body Legend.Roles is

   -- 当前人物移动流程 
   -- 创建一个Walk_Timer
   -- 在Walk_Timer触发时调整位置
   -- 开始移动时, 设置走动动画

   procedure Setup (
      this  : in out Role_Type;
      Stage : not null access Stages.Stage_Type'Class;
      State : not null access Hero_Type
      )
   is
   begin
      this.F_Stage := Stage;
      this.F_Label.Visible := False;
      this.F_Stage.Add_Control(this.F_Label'Unchecked_Access);
      this.F_State := State;
      this.F_Movie.Pictures := Stage.Get_Pictures;
   end Setup;

   function Prototype (
      this : Role_Type
      ) return access Hero_Type
   is
   begin
      return this.F_State;
   end Prototype;

   function Visible (this : Role_Type) return Boolean
   is
   begin
      return this.F_Visible;
   end Visible;

   function Position (this : in out Role_Type) return Point_Type
   is
   begin
      return this.F_Position;
   end Position;

   procedure Position (
      this     : in out Role_Type;
      Position : Point_Type
      )
   is
   begin
      if this.Visible then
         this.F_Stage.Move_Movie(this.F_Stage.Sprite_Layer, this.Position, Position);
      else
         this.F_Stage.Set_Movie_At(Position, this.F_Movie, this.F_Stage.Sprite_Layer);
      end if;
      this.F_Position := Position;
   end Position;

   function Next_Position (
      this : in out Role_Type
      ) return Point_Type
   is
   begin
      return this.F_Position + Face_To_Offset(this.F_Face);
   end Next_Position;

   function Show_Route (this : Role_Type) return Boolean
   is
   begin
      return this.F_Route_Visible;
   end Show_Route;

   procedure Show_Route (this : in out Role_Type; Visible : Boolean := True)
   is
   begin
      this.F_Route_Visible := Visible;
      if Visible then
         for p of this.F_Route loop
            this.F_Stage.Set(ml_Earth, p, 2);
         end loop;
      else
         for r of this.F_Route_Overlay loop
            this.F_Stage.Set(ml_Earth, r.Where, r.Value);
         end loop;
      end if;
   end Show_Route;

   procedure Search_Route (
      this : in out Role_Type;
      Where : Point_Type
      )
   is
      Ignore_Obstacle : Boolean := False;

      procedure Add_To_Path (P : Point_Type) 
      is
      begin
         this.F_Route.Prepend(P);
         this.F_Route_Overlay.Prepend((P, this.F_Stage.Get(ml_Earth, P)));
      end Add_To_Path;

      function Can_Walk (P : Point_Type) return Boolean
      is
      begin
         if Ignore_Obstacle then
            return True;
         end if;
         return not this.F_Stage.Has_Obstacle_At(P, this.Horse);
      end Can_Walk;

      procedure Search_Path is new Generic_Search_Path(Add_To_Path, Can_Walk);
   begin
      this.F_Route.Clear;
      this.F_Route_Overlay.Clear;
      Search_Path(this.F_Stage.Get_Map_Region, this.Position, Where);
      if this.F_Route.Is_Empty then
         Ignore_Obstacle := True;
         Search_Path(this.F_Stage.Get_Map_Region, this.Position, Where);
         this.F_Route.Clear;
         Ignore_Obstacle := False;
         for r of this.F_Route_Overlay loop
            exit when not Can_Walk(r.Where);
            this.F_Route.Append(r.Where);
         end loop;
      end if;
   end Search_Route;

   procedure Clear_Route (this : in out Role_Type)
   is
   begin
      this.F_Route.Clear;
   end Clear_Route;

   procedure Move_To (this : in out Role_Type; Where : Point_Type)
   is
      function Over return Boolean
      is
      begin
         return this.F_Route.Is_Empty;
      end Over;
   begin
      this.Search_Route(Where);
      this.Start_Walk;
      this.F_Stage.Switch_To_Movie_Mode(Over'Access);
   end Move_To;

   function Face (this : in out Role_Type) return Face_Type
   is
   begin
      return this.F_Face;
   end Face;

   procedure Face (
      this : in out Role_Type;
      Face : Face_Type;
      Walk : Boolean := False
      )
   is
   begin
      if Face /= this.F_Face then
         this.F_Face := Face;
         this.Stand;
      end if;
      if Walk then
         Role_Class(this).Start_Walk;
      end if;
   end Face;

   function Horse (
      this  : Role_Type
      ) return Horse_Type
   is
   begin
      return this.F_Horse;
   end Horse;

   procedure Horse (
      this  : in out Role_Type;
      Horse : Horse_Type
      )
   is
   begin
      if Horse /= this.F_Horse then
         this.F_Horse := Horse;
      end if;
      this.Reset_Movie;
   end Horse;

   procedure Speed (
      this  : in out Role_Type;
      Speed : Duration
      )
   is
   begin
      if Speed > 0.0 then
         this.F_Speed := Speed;
      end if;
   end Speed;

   procedure Action (
      this : in out Role_Type;
      Code : Action_Code
      )
   is
   begin
      this.F_Current_Action := Code;
   end Action;

   function Current_Action (
      this : in out Role_Type
      ) return Action_Code
   is
   begin
      return this.F_Current_Action;
   end Current_Action;

   procedure Start_Walk (this : in out Role_Type)
   is
   begin
      if not this.Is_Walking then
         Timers.World_Clock.Add_Timer (
            Interval => 1.0 / this.F_Speed, 
            Repeat   => 0, 
            Id       => this.F_Walk_Timer);
         -- maybe doing other action
         this.Hide;
         this.Reset_Movie;
         this.Action(Action_Codes.Walk);
         this.Show;
      end if;
   end Start_Walk;

   procedure Stand (this : in out Role_Type)
   is
   begin
      this.Hide;
      this.Reset_Movie;
      this.F_Movie.Total := 1;
      this.F_Current_Action := Action_Codes.Stand;
      this.Show;
   end Stand;

   procedure Stop_Walk (this : in out Role_Type)
   is
   begin
      if this.Is_Walking then
         Timers.World_Clock.Delete_Timer(this.F_Walk_Timer);
         this.F_Walk_Timer := 0;
         this.Stand;
      end if;
   end Stop_Walk;

   procedure On_Before_Walk (
      this   : in out Role_Type; 
      Target : Point_Type;
      Allow  : in out Boolean
      )
   is
   begin
      if Allow then
         Allow := not this.F_Stage.Has_Obstacle_At(Target, this.Horse);
      end if;
   end On_Before_Walk;

   procedure Walk (this : in out Role_Type)
   is
      ofs : Point_Type;
      m : Point_Type;
      allow_walk : Boolean;
      route_completed : Boolean := False;
      procedure Move 
      is
      begin
         this.F_Stage.Move_Movie(this.F_Stage.Sprite_Layer, this.Position, m);
         this.F_Position := m;
         this.F_Stage.Scroll_Map_By(ofs);
         Role_Class(this).On_After_Walk;
      end Move;

      procedure Check_Horse_State 
      is
      begin
         -- check need switch horse
         case this.Horse is
            when No_Horse =>
               declare
                  h : Horse_Type := No_Horse;
               begin
                  this.F_Stage.Get_Horse_At(m, h);
                  if h /= No_Horse then
                     this.F_Stage.Set_Building_At(m, 0);
                     this.Stop_Walk;
                     this.Horse(h);
                     Trace_Log("switch horse to " & h'Img);
                     this.Start_Walk;
                     Move;
                  end if;
               end;
            when Boat =>
               if not this.F_Stage.Has_Obstacle_At(m, No_Horse) then
                  this.Stop_Walk;
                  this.Horse(No_Horse);
                  Trace_Log("switch horse to no horse");
                  declare
                     p : Point_Type := this.Position;
                  begin
                     this.Start_Walk;
                     Move;
                     this.F_Stage.Set_Horse_At(p, Boat, this.Face);
                  end;
               end if;
         end case;
      end Check_Horse_State;
   begin
      if this.F_Route.Is_Empty then
         ofs := Face_To_Offset(this.Face);
         m := this.Position + ofs;
      else
         -- move by route
         m := this.F_Route.First_Element;
         ofs := m - this.Position;
         this.F_Route.Delete_First;
         declare
            F : Face_Type := Offset_To_Face(ofs);
         begin
            if F /= this.Face then
               this.Stop_Walk;
               this.Face(F, True);
            end if;
         end;
         if this.F_Route.Is_Empty then
            route_completed := True;
         end if;
      end if;
      allow_walk := this.F_Stage.Is_In_Map(m);
      Role_Class(this).On_Before_Walk(m, allow_walk);
      if allow_walk then
         Move;
      else
         Check_Horse_State;
      end if;
      if route_completed then
         this.Stop_Walk;
      end if;
   end Walk;

   procedure Show (this : in out Role_Type)
   is
   begin
      if not this.Visible then
         this.F_Stage.Set_Movie_At(this.Position, this.F_Movie, this.F_Stage.Sprite_Layer);
         this.F_Visible := True;
      end if;
   end Show;

   procedure Hide (this : in out Role_Type)
   is
   begin
      if this.Visible then
         this.F_Stage.Remove_Movie_At(this.F_Stage.Sprite_Layer, this.Position);
         this.F_Visible := False;
      end if;
   end Hide;

   procedure Play (
      this    : in out Role_Type;
      Movie   : Movie_Type;
      Expired : Duration
      )
   is
   begin
      this.F_Movie := Movie;
      this.F_Stage.Set_Movie_At(this.Position, Movie, this.F_Stage.Sprite_Layer, Expired => Expired);
      -- this.F_Movie.Index := 1;
   end Play;

   procedure Play (
      this  : in out Role_Type;
      Movie : Movie_Type;
      Count : Natural := 0 -- 0 means infinite loop
      )
   is
   begin
      if Count = 0 then
         this.Play(Movie, Expired => Loop_Infinite);
      else
         this.Play(Movie, Expired => Duration(Movie.Total) * Movie.Interval);
      end if;
   end Play;

   procedure Focus (this : in out Role_Type)
   is
   begin
      this.F_Stage.Scroll_To_Canvas_Center(this.Position);
   end Focus;

   procedure Reset_Movie (this : in out Role_Type)
   is
   begin
      if this.F_Face'Valid and this.F_Horse'Valid then
         Get_Action_Movie_From_Group(
            this.F_Horse_Movies(this.F_Horse), 
            Face_Type'Pos(this.Face), 
            this.F_Movie);
         this.F_Movie.Pictures := this.F_Stage.Get_Pictures;
         this.F_Movie.Interval := 1.0 / this.F_Speed;
      end if;
   end Reset_Movie;

   procedure On_Timer (
      this  : in out Role_Type; 
      Timer : Hash_Type;
      Count : Natural
      )
   is
   begin
      if Timer /= 0 then
         if this.F_Walk_Timer = Timer then
            this.Walk;
         end if;
      end if;
   end On_Timer;

   procedure Horse_Movies (
      this   : in out Role_Type;
      Movies : Horse_Movie_Groups_Type
      )
   is
   begin
      this.F_Horse_Movies := Movies;
   end Horse_Movies;

   procedure Begin_Update (this : in out Role_Type)
   is
   begin
      this.F_Updating := True;
   end Begin_Update;

   procedure End_Update (this : in out Role_Type)
   is
   begin
      this.F_Updating := False;
   end End_Update;


   function Is_Walking (
      this : in out Role_Type
      ) return Boolean
   is
   begin
      return this.F_Walk_Timer /= 0;
   end Is_Walking;

   procedure Use_Item (this : in out Role_Type; Item : in out Item_Type)
   is
   begin
      case Item.Kind is
         when ik_Drug_Item =>
            this.F_Stage.Use_Drug_Item(Item);
         when ik_Study_Book =>
            this.F_Stage.Use_Study_Book(Item);
         when ik_Story_Item =>
            this.F_Stage.Use_Story_Item(Item);
         when ik_Throw_Item =>
            this.F_Stage.Use_Throw_Item(Item);
         when ik_Equip_Item =>
            this.F_Stage.Use_Equip_Item(Item);
         when others =>
            null;
      end case;
   end Use_Item;

   procedure Emit (
      this  : in out Role_Type; 
      S     : UTF8_String;
      Color : Color_Type := Colors.White;
      Life  : Duration := 1.0
      )
   is
   begin
      this.F_Label.Font.Color := Color;
      this.F_Label.Back_Color.A := 0;
      this.F_Label.Text(S);
      this.F_Label.Paint;
      this.F_Label.Visible := True;
      this.F_Label.Life := Clock + Life;
      this.F_Stage.Canvas.Invalidate;
   end Emit;

   overriding
   procedure Initialize (this : in out Role_Type)
   is
   begin
      this.F_State := null;
      this.F_Stage := null;
      this.F_Visible := False;
      this.F_Updating := False;
      this.F_Position := (0, 0);
      this.F_Speed := 2.0;
      this.F_Face := Face_Type'First;
      this.F_Horse := Horse_Type'First;
      this.F_Movie := (
         Pictures => null, 
         Total    => 1, 
         Index    => 0,
         First    => 0,
         Interval => 1.0 / this.F_Speed,
         Timer    => 0);
      this.F_Horse_Movies := (others => (others => 0));
      this.F_Walk_Timer := 0;
      this.F_Current_Action := Action_Codes.Stand;
   end Initialize;

   overriding
   procedure Finalize (this : in out Role_Type)
   is
   begin
      Trace_Log("destorying " & To_UTF8_Name(this.Prototype.Name));
      this.Stop_Walk;
      if this.F_Stage /= null then
         this.F_Stage.Remove_Control(this.F_Label'Unchecked_Access);
      end if;
   end Finalize;

   procedure Dispose (List : in out Roles_Access) 
   is
      procedure Free is 
         new Ada.Unchecked_Deallocation (Roles_Type, Roles_Access);
   begin
      if List /= null then
         for who of List.all loop
            Dispose(who);
         end loop;
         Free(List);
      end if;
   end Dispose;

   procedure Dispose (this : in out Role_Pointer)
   is
      pragma Inline (Dispose);
      procedure Free is
         new Ada.Unchecked_Deallocation (Role_Class, Role_Pointer);
   begin
      Free (this);
   end Dispose;

   procedure Prepare (this : in out Role_Label_Type)
   is
      v, c : Point_Type;
   begin
      if this.Visible then
         this.Owner.F_Stage.Map_To_View(this.Owner.Position, v);
         this.Owner.F_Stage.View_To_Canvas(v, c);
         this.Position := c - (18, 64 + Int16_t(this.Font.Size));
      end if;
   end Prepare;

end Legend.Roles;
